home *** CD-ROM | disk | FTP | other *** search
/ Pascal Super Library / Pascal Super Library (CW International)(1997).bin / LIBRARY / MWCC03 / MESSAGE.ZIP / MSGUNIT.PAS < prev    next >
Pascal/Delphi Source File  |  1993-08-18  |  27KB  |  855 lines
  1. {**********************************************************************}
  2. {*                                                                    *}
  3. {*          Microworks Sample Application                                        *}
  4. {*                                                                    *}
  5. {*         for Borland Pascal v7.0 and Turbo Pascal for Windows v1.5           *}
  6. {*                                                                    *}
  7. {*     Copyright 1992-93 Jeff Franks (Microworks) Sydney, Australia.  *}
  8. {*                                                                    *}
  9. {*         You are free to use, modify, reproduce and distribute the      *}
  10. {*         Sample Files (and/or any modified version) in any way you      *}
  11. {*         find useful.                                                                *}
  12. {*                                                                    *}
  13. {**********************************************************************}
  14.  
  15. {*** Introduction
  16.  
  17.     Unit           := MsgUnit
  18.  
  19.     Files          := Msgunit.pas
  20.  
  21.     Units Required := MWCC.dll
  22.  
  23.     Tabs           := 2
  24.  
  25.     Screen         := 800 * 600
  26.  
  27.     Date           := August, 1993.
  28.  
  29.     MsgUnit is the complete source code for the MWCC and SFX message boxes. It includes
  30.     the drawing, painting and keydown procedures from MWCC.dll (not found in MMsgBox.pas
  31.     in RTL.ZIP). I've included this source code as an example of how to write a non-OWL
  32.     application should the need arise - like in a DLL.
  33.  
  34. {*** About the Message Box unit
  35.  
  36.     I rewrote to OWL MWCC and SFX message boxes from the previous version (in the MWCC unit in
  37.     MWCC02.ZIP) because I wanted to put the message boxes in MWCC.dll. Initially I rewrote
  38.     the message boxes using the DLLAPP.ZIP sample found in the BPascal forum's OWL library
  39.     (No 8). It worked great - 90% of the time, but every now and then I got a general
  40.     protection fault. The best I could do to trace the fault was to the behind the scenes
  41.     TWindowsObject.GetObjectPtr routine for the dummy DLLAPP Window. After weeks of hasle I
  42.     decided it would be quicker to rewrite the message boxes without Object Windows. One week
  43.     later and everything was working well. Best of all the exe files were about 4-5k smaller.
  44.  
  45.     Then I hit another problem. You can't have multiple instances in a DLL. Because only one
  46.     instance of a dll is ever loaded, the second instance of an application that is run from
  47.     a DLL overwrites the data for the first instance. When you close the second instance your
  48.     left with the first instance and no data. This leaves you    with is a window shell that
  49.     doesn't know what to do with itself.
  50.  
  51.     I managed to find a multiple instance DLL that uses assembly code to keep a list of tasks.
  52.     Each new task that uses the DLL gets its own data segment. Unfortunaltely, it would have
  53.     taken too long to rewrite the message boxes a third time so I left that until the next
  54.     version.
  55.  
  56.     MsgUnit imports the MWCC.dll procedures and functions it needs itself, so it doesn't need
  57.     MObjects.
  58.  
  59.     One advantage of using generic Pascal programming to write a Windows program is that it
  60.     produces a smaller exe file.
  61.  
  62.     When reading through the code everything is more or less upside down compared to an OWL
  63.     program because functions and procedures must be declared before they can be used. you might
  64.     find it easier to start at the bottom - at the MsgBoxWinMain procedure.
  65.  
  66.     The code might look a little more complicated (or messy) because it is used to display two
  67.     different types of message boxes.
  68.  
  69.     To use this unit compile it and then compile and run the Msgtest program.
  70.  
  71.     I hope you find this unit useful.
  72.  
  73.     Jeff...
  74.  
  75. ***}
  76.  
  77. unit MsgUnit;
  78.  
  79. interface
  80.  
  81. uses WinProcs, WinTypes;
  82.  
  83. type
  84.  
  85.     TMinMaxInfo = array [0..4] of TPoint;
  86.     PMinMaxInfo = ^TMinMaxInfo;
  87.  
  88.     function  MWCCMsgBox (WndParent: HWnd; ATxt, ACaption: PChar; ATextType: Word;
  89.                                                 ABmp: PChar): Integer;
  90.  
  91.     function  SFXMsgBox (WndParent: HWnd; ATxt, ACaption: PChar; ATextType: Word): Integer;
  92.  
  93.     function  CreateDefaultFont (IsBold: Boolean): HFont;
  94.  
  95.     procedure Draw3DBorder (Wnd: HWnd; X, Y, W, H: Integer; Shade: Word);
  96.  
  97.     procedure DrawSFXFrame (Wnd: HWnd);
  98.  
  99. implementation
  100.  
  101. const
  102.  
  103.     ctl_Recessed = 51;
  104.     ctl_Raised   = 52;
  105.  
  106. var
  107.  
  108.     Default1    : Boolean;
  109.     Default2    : Boolean;
  110.     Default3    : Boolean;
  111.     SFXStyle    : Boolean;
  112.     BkBmp       : HBitmap;
  113.     MsgBmp      : HBitmap;
  114.     UpBmp1      : HBitmap;
  115.     UpBmp2      : HBitmap;
  116.     UpBmp3      : HBitmap;
  117.     BkBrush     : HBrush;
  118.     LastWnd     : HWnd;
  119.     MsgBoxWnd   : HWnd;
  120.     WndButton1  : HWnd;
  121.     WndButton2  : HWnd;
  122.     WndButton3  : HWnd;
  123.     ID1         : Integer;
  124.     ID2         : Integer;
  125.     ID3         : Integer;
  126.     a           : Integer;
  127.     b           : Integer;
  128.     c           : Integer;
  129.     d           : Integer;
  130.     e           : Integer;
  131.     f           : Integer;
  132.     Reply       : Integer;
  133.     ButtonProc1 : TFarProc;
  134.     ButtonProc2 : TFarProc;
  135.     ButtonProc3 : TFarProc;
  136.     OldProc1    : TFarProc;
  137.     OldProc2    : TFarProc;
  138.     OldProc3    : TFarProc;
  139.     HLib        : THandle;
  140.     MWCCWndHdl  : THandle;
  141.     SFXWndHdl   : THandle;
  142.     WinRect     : TRect;
  143.     TextType    : Word;
  144.     szText      : array[0..255] of Char;
  145.     szTitle     : array[0..50] of Char;
  146.  
  147. function  CreateDefaultFont; external 'MWCC' Index 1;
  148.  
  149. procedure Draw3DBorder; external 'MWCC' Index 5;
  150.  
  151. procedure DrawSFXFrame; external 'MWCC' Index 10;
  152.  
  153. procedure DrawMsgBoxButton (Wnd: HWnd; lParam: LongInt);
  154. {*** From MWCC.dll
  155.  
  156.     Draws the Message box buttons. It's a bit slow when launching the message box
  157.     because it loads each bitmap as it needs it. To overcome this the bitmaps that
  158.     need to be displayed initially (the up bitmaps) are loaded before the window is
  159.     constructed.
  160.  
  161. ***}
  162. var
  163.     Down      : Boolean;
  164.     Up        : Boolean;
  165.     Other     : Boolean;
  166.     Bitmap    : HBitmap;
  167.     MemDC     : HDC;
  168.     Offset    : Integer;
  169.     OldObject : THandle;
  170. begin
  171.     with pDrawItemStruct(lParam)^, rcItem do
  172.         case CtlType of
  173.             odt_Button:
  174.             begin
  175.                 if ItemAction = oda_Focus then exit;
  176.                 Down := ((ItemAction and oda_Select) > 0) and ((ItemState and ods_Selected) > 0);
  177.                 Up := ((ItemAction and oda_Select) > 0) and ((ItemState and ods_Selected) = 0);
  178.                 Other := ((ItemAction and oda_Select) = 0) and ((ItemState and ods_Selected) = 0);
  179.                 FillRect(HDC, rcItem, GetStockObject(LtGray_Brush));
  180.                 Draw3DBorder(HWndItem, Left, Top, Right-Left, Bottom-Top, ctl_Recessed);
  181.                 MemDC := CreateCompatibleDC(HDC);
  182.                 if (GetFocus = HWndItem) then
  183.                 begin
  184.                     if Down then
  185.                         OffSet := 3000
  186.                     else
  187.                         OffSet := 5000;
  188.                 end
  189.                 else
  190.                 begin
  191.                     if Down then
  192.                         OffSet := 3000
  193.                     else
  194.                     if Up then
  195.                         OffSet := 5000
  196.                     else
  197.                     if Other then
  198.                         OffSet := 1000;
  199.                 end;
  200.                 Bitmap := LoadBitmap(HLib, PChar(OffSet + CtlID));
  201.                 OldObject := SelectObject(MemDC, Bitmap);
  202.                 BitBlt(HDC, Left, Top, Right-Left, Bottom-Top, MemDC, 0, 0, SrcCopy);
  203.                 SelectObject(MemDC, OldObject);
  204.                 DeleteObject(Bitmap);
  205.                 DeleteDC(MemDC);
  206.             end;
  207.         end;
  208. end;
  209.  
  210. procedure MsgBoxKeyDown (ParentWnd, Wnd: HWnd; wParam: Word);
  211. {*** From MWCC.dll
  212.  
  213.     MsgBoxKeyDown handles tabbing through the buttons. Because the message box is a window
  214.     and not a dialog tabbing doesn't automatically occur. EnableKBHandler can't be used here
  215.     because this is a non_OWL program.
  216.  
  217. ***}
  218. var
  219.     SibWnd : HWnd;
  220.     lStyle : LongInt;
  221.     ID     : Word;
  222. begin
  223.     SibWnd := 0;
  224.     ID := GetDlgCtrlID(Wnd);
  225.     case wParam of
  226.         vk_Return :
  227.         begin
  228.             SendMessage(MsgBoxWnd, wm_Command, ID, ID + bn_Clicked);
  229.             Exit;
  230.         end;
  231.     end;
  232.     while SibWnd = 0 do
  233.     begin
  234.         if ID = 7 then
  235.             ID := 1
  236.         else
  237.             ID := ID + 1;
  238.         SibWnd := GetDlgItem(MsgBoxWnd, ID);
  239.         lStyle := GetWindowLong (SibWnd, gwl_Style);
  240.         if not (lStyle = lStyle or ws_TabStop) then
  241.             SibWnd := 0;
  242.     end;
  243.     case wParam of
  244.         vk_Tab:
  245.         begin
  246.             SetFocus(SibWnd);
  247.             InvalidateRect(Wnd, nil, True);
  248.             InvalidateRect(SibWnd, nil, True);
  249.         end;
  250.     end;
  251. end;
  252.  
  253. procedure PaintMsgBox (Wnd: HWnd; AText: PChar; Ofs1, Ofs2, Ofs3: Integer;
  254.                                              MsgBmp: HBitmap; SFXStyle: Boolean);
  255. {*** From MWCC.dll
  256.  
  257.     PaintMsgBox handles all the painting. It paints the window differently depending on whether
  258.     it's asn SFX message box (SFXStyle := true).
  259.  
  260. ***}
  261. var
  262.     OldBrush  : HBrush;
  263.     NewBrush  : HBrush;
  264.     MemDC     : HDC;
  265.     PaintDC   : HDC;
  266.     MsgFont   : HFont;
  267.     OldObject : THandle;
  268.     PS        : TPaintStruct;
  269.     CRect     : TRect;
  270.     FRect     : TRect;
  271.     W, H      : Integer;
  272.     TextRect  : TRect;
  273. begin
  274.     BeginPaint(Wnd, PS);
  275.     PaintDC := GetDC(Wnd);
  276.     GetClientRect (Wnd, CRect);
  277.     with CRect do
  278.     begin
  279.         W :=  Right;
  280.         H :=  Bottom;
  281.     end;
  282.     if SFXStyle then
  283.         Draw3DBorder(Wnd, 23 - (Ofs2 div 2), 21, 342 + Ofs1 - (Ofs2 div 2), 98, ctl_Recessed)
  284.     else
  285.     begin
  286.         Draw3DBorder(Wnd, 1, 1, W-2, H-2, ctl_Raised);
  287.         Draw3DBorder(Wnd, 22, 22, 340 + Ofs1, 98, ctl_Recessed);
  288.         with FRect do
  289.         begin
  290.             Left := 23;
  291.             Top := 23;
  292.             Right := W-23;
  293.             Bottom := 119;
  294.         end;
  295.         FillRect(PaintDC, FRect, GetStockObject(LtGray_Brush));
  296.     end;
  297.     if MsgBmp <> 0 then
  298.     begin
  299.         MemDC := CreateCompatibleDC(PaintDC);
  300.         OldObject := SelectObject(MemDC, MsgBmp);
  301.         BitBlt(PaintDC, 30 - (Ofs2 div 2), 32 - Ofs3, 48, 64, MemDC, 0, 0, SrcCopy);
  302.         SelectObject(MemDC, OldObject);
  303.         DeleteDC(MemDC);
  304.     end;
  305.     with TextRect do
  306.     begin
  307.         Left   := 84 - (Ofs2 div 2);
  308.         Top    := 32 - Ofs3;
  309.         Right  := 272 + Ofs1 - (Ofs2 div 2) + Left;
  310.         Bottom := 80 + Top;
  311.     end;
  312.     MsgFont := CreateDefaultFont(True);
  313.     SetBkMode(PaintDC, Transparent);
  314.     OldObject := SelectObject(PaintDC, MsgFont);
  315.     DrawText(PaintDC, AText, lStrLen(AText), TextRect, dt_Top or dt_Left or dt_WordBreak);
  316.     SelectObject(PaintDC, OldObject);
  317.     DeleteObject(MsgFont);
  318.     ReleaseDC(Wnd, PaintDC);
  319.     EndPaint(Wnd, PS);
  320. end;
  321.  
  322. procedure InitializeData;
  323. {*** Used to initialize all the data when the message box is created and destroyed ***}
  324. begin
  325.     Default1    := False;
  326.     Default2    := False;
  327.     Default3    := False;
  328.     SFXStyle    := False;
  329.     BkBmp       := 0;
  330.     MsgBmp      := 0;
  331.     UpBmp1      := 0;
  332.     UpBmp2      := 0;
  333.     UpBmp3      := 0;
  334.     BkBrush     := 0;
  335.     LastWnd     := 0;
  336.     MsgBoxWnd   := 0;
  337.     WndButton1  := 0;
  338.     WndButton2  := 0;
  339.     WndButton3  := 0;
  340.     ID1         := 0;
  341.     ID2         := 0;
  342.     ID3         := 0;
  343.     a           := 0;
  344.     b           := 0;
  345.     c           := 0;
  346.     d           := 0;
  347.     e           := 0;
  348.     f           := 0;
  349.     ButtonProc1 := nil;
  350.     ButtonProc2 := nil;
  351.     ButtonProc3 := nil;
  352.     OldProc1    := nil;
  353.     OldProc2    := nil;
  354.     OldProc3    := nil;
  355.     HLib        := 0;
  356.     MWCCWndHdl  := 0;
  357.     SFXWndHdl   := 0;
  358. end;
  359.  
  360. function MsgBoxButton1Proc (Wnd: HWnd; Message, wParam: Word; lParam: Longint): Longint; export;
  361. {***
  362.  
  363.     Subclassing routine for the first message box button. It's used to handle WMkeydown messages
  364.     so that you can tab through the buttons. Basically you only need to subclass when a window
  365.     or dialog control needs to handle its own messages. All messages pass through this function.
  366.     You just add the messages you want to handle to the case statement and pass the rest onto
  367.     the parent window using CallWindowProc. OldProc1 is a pointer to the parent's window procedure
  368.     that handles all the parent messages.
  369.  
  370. ***}
  371. begin
  372.     MsgBoxButton1Proc := 0;
  373.     case Message of
  374.         wm_KeyDown : MsgboxKeyDown(MsgBoxWnd, Wnd, wParam);
  375.     end;
  376.     MsgBoxButton1Proc :=    CallWindowProc (OldProc1, Wnd, Message, wParam, lParam);
  377. end;
  378.  
  379. function MsgBoxButton2Proc (Wnd: HWnd; Message, wParam: Word; lParam: Longint): Longint; export;
  380. {*** Subclassing routine for the second message box button ***}
  381. begin
  382.     MsgBoxButton2Proc := 0;
  383.     case Message of
  384.         wm_KeyDown : MsgboxKeyDown(MsgBoxWnd, Wnd, wParam);
  385.     end;
  386.     MsgBoxButton2Proc :=    CallWindowProc (OldProc2, Wnd, Message, wParam, lParam);
  387. end;
  388.  
  389. function MsgBoxButton3Proc (Wnd: HWnd; Message, wParam: Word; lParam: Longint): Longint; export;
  390. {*** Subclassing routine for the third message box button ***}
  391. begin
  392.     MsgBoxButton3Proc := 0;
  393.     case Message of
  394.         wm_KeyDown : MsgboxKeyDown(MsgBoxWnd, Wnd, wParam);
  395.     end;
  396.     MsgBoxButton3Proc :=    CallWindowProc (OldProc3, Wnd, Message, wParam, lParam);
  397. end;
  398.  
  399. function MsgBoxProc(Wnd: HWnd; Message, wParam: Word; lParam: Longint): Longint; export;
  400. {***
  401.  
  402.     MsgBoxProc is the callback procedure that handles all the messages for the message box
  403.     window. It works the same as for the buttons except because it's the parent it passes
  404.     the messages it doesn't handle onto DefWindowProc. This includes any child messages
  405.     returned to it. This function is called a Window Procedure (WindowProc) and it can have
  406.     any name you want. The window procdure is assigned to a window class in a TWndClass
  407.     structure. All windows created with the same class use the same window procdure. Any
  408.     children that need to handle their own messages must be subclassed. This can be done in
  409.     a wm_Create method added to the case statement but I found it better to do it in the
  410.     main window procedure 'MsgBoxWinMain' (WinMain).
  411.  
  412. ***}
  413. type
  414.     NCRect = array[0..2] of TRect;
  415.     PRect  = ^NCRect;
  416. var
  417.     MinMaxInfo : PMinMaxInfo;
  418. begin
  419.     MsgBoxProc := 0;
  420.     case Message of
  421.         wm_Destroy:
  422.         begin
  423.             if HLib >= 32 then FreeLibrary(HLib);
  424.             if BkBmp <> 0 then
  425.             begin
  426.                 DeleteObject(BkBmp);
  427.                 DeleteObject(BkBrush);
  428.             end;
  429.             if MsgBmp <> 0 then DeleteObject(MsgBmp);
  430.             if UpBmp1 <> 0 then DeleteObject(UpBmp1);
  431.             if UpBmp2 <> 0 then DeleteObject(UpBmp2);
  432.             if UpBmp3 <> 0 then DeleteObject(UpBmp3);
  433.             {***
  434.  
  435.                 PostQuitMessage send a wm_Quit message to the window so it exits the GetMessage
  436.                 message loop in the MsgBoxWinMain procedure.
  437.  
  438.             ***}
  439.             PostQuitMessage(0);
  440.             Exit;
  441.         end;
  442.         wm_Paint:
  443.         begin
  444.             PaintMsgBox (Wnd, szText, a, e, f, MsgBmp, SFXStyle);
  445.             if SFXStyle then DrawSFXFrame(Wnd);
  446.         end;
  447.         wm_DrawItem: DrawMsgBoxButton(Wnd, lParam);
  448.         wm_Command:
  449.         begin
  450.             {***
  451.  
  452.                 There are no Msg.lParam Hi's or Lo's in TMsg so you have to use HiWord/LoWord.
  453.                 When a button is clicked 'Reply' is the return value passed back to the message box
  454.                 function. LastWnd (WndParent from the message box function) is enabled and is given
  455.                 the focus. DestroyWindow sends a wm_Destroy message (which is handled above) to the
  456.                 window and lastly    the window is unregistered. I need to unregister the window because
  457.                 there are four possible registrations and I don't know which style of messagebox will
  458.                 be registered next. You might use more than one type in a program as I did in the
  459.                 MDITool sample.
  460.  
  461.             ***}
  462.             if HiWord(lParam) = bn_Clicked then
  463.             begin
  464.                 Reply := wParam;
  465.                 EnableWindow(LastWnd, True);
  466.                 SetFocus(LastWnd);
  467.                 DestroyWindow(Wnd);
  468.                 if SFXStyle  then
  469.                     UnregisterClass('SFXMsgBoxWindow', SFXWndHdl)
  470.                 else
  471.                     UnregisterClass('MWCCMsgBoxWindow', MWCCWndHdl);
  472.             end;
  473.         end;
  474.         wm_NCPaint:
  475.         begin
  476.             if SFXStyle then
  477.             begin
  478.                 DrawSFXFrame(Wnd);
  479.                 GetWindowText(Wnd, szTitle, sizeof(szTitle));
  480.                 SetWindowText(Wnd, szTitle);
  481.                 {***
  482.  
  483.                     MsgBoxProc := 1 is the same as Msg.Result := 1 in an OWL program.
  484.                     It is the return value for the message.
  485.  
  486.                 ***}
  487.                 MsgBoxProc := 1;
  488.                 {***
  489.  
  490.                     If you want to override the default message behaviour then don't pass the message
  491.                     onto DefWindowProc - just Exit.
  492.  
  493.                 ***}
  494.                 Exit;
  495.             end;
  496.         end;
  497.         wm_NCCalcSize: if SFXStyle then Inc(PRect(lParam)^[0].Top, 1);
  498.         wm_Activate: if SFXStyle then DrawSFXFrame(Wnd);
  499.         wm_NCActivate: if SFXStyle then DrawSFXFrame(Wnd);
  500.         wm_ActivateApp: if SFXStyle then DrawSFXFrame(Wnd);
  501.         wm_GetMinMaxInfo:
  502.         begin
  503.             longInt(MinMaxInfo) := lParam;
  504.             GetWindowRect(Wnd, WinRect);
  505.             if ((WinRect.Right-WinRect.Left) > 36) and ((WinRect.Bottom-WinRect.Top) > 36) then
  506.             begin
  507.                 MinMaxInfo^[1].X :=  WinRect.Right - WinRect.Left;
  508.                 MinMaxInfo^[1].Y :=  WinRect.Bottom - WinRect.Top;
  509.                 MinMaxInfo^[3].X :=  WinRect.Right - WinRect.Left;
  510.                 MinMaxInfo^[3].Y :=  WinRect.Bottom - WinRect.Top;
  511.                 MinMaxInfo^[4].X :=  WinRect.Right - WinRect.Left;
  512.                 MinMaxInfo^[4].Y :=  WinRect.Bottom - WinRect.Top;
  513.             end;
  514.         end;
  515.     end;
  516.     {*** Passes all messages that reach this point onto DefWindowProc ***}
  517.     MsgBoxProc := DefWindowProc(Wnd, Message, wParam, lParam);
  518. end;
  519.  
  520. procedure MsgBoxWinMain (WndParent: HWnd; ATxt, ACaption: PChar; ATextType: Word; ABmp: PChar);
  521. {*** WinMain Window function
  522.  
  523.     WinMain is not defined in Pascal so you can call this procedure anything you like and give
  524.     it any parameters. One thing to remember - to make the window appear as fast as possible
  525.     initialize everything you can before you actually create the mainwindow.
  526.  
  527. ***}
  528. label
  529.     CaseExit;
  530. const
  531.     {*** Class Sructure for MWCCMsgBox ***}
  532.     MWCCWndClass : TWndClass = (style         : 0;
  533.                                                             lpfnWndProc   : @MsgBoxProc; {MsgBoxProc Window Procedure}
  534.                                                             cbClsExtra    : 0;
  535.                                                             cbWndExtra    : 0;
  536.                                                             hInstance     : 0;
  537.                                                             hIcon         : 0;
  538.                                                             hCursor       : 0;
  539.                                                             hbrBackground : 0;
  540.                                                             lpszMenuName  : nil;
  541.                                                             lpszClassName : 'MWCCMsgBoxWindow');
  542.  
  543.     {*** Class Sructure for SFXMsgBox ***}
  544.     SFXWndClass : TWndClass = (style         : 0;
  545.                                                          lpfnWndProc   : @MsgBoxProc; {Uses the same Window Procedure}
  546.                                                          cbClsExtra    : 0;
  547.                                                          cbWndExtra    : 0;
  548.                                                          hInstance     : 0;
  549.                                                          hIcon         : 0;
  550.                                                          hCursor       : 0;
  551.                                                          hbrBackground : 0;
  552.                                                          lpszMenuName  : nil;
  553.                                                          lpszClassName : 'SFXMsgBoxWindow');
  554. var
  555.     SysMenu  : HMenu;
  556.     FocusWnd : HWnd;
  557.     W        : Integer;
  558.     H        : Integer;
  559.     XScreen  : Integer;
  560.     YScreen  : Integer;
  561.     Msg      : TMsg;
  562.  
  563.     {*** Loads the big message bitmaps ***}
  564.     procedure LoadBmp (wBmp: Word);
  565.     begin
  566.         if wBmp = 0  then MsgBmp := 0;
  567.         if wBmp = 16 then MsgBmp := LoadBitmap(HLib, PChar(1901));
  568.         if wBmp = 32 then MsgBmp := LoadBitmap(HLib, PChar(1902));
  569.         if wBmp = 48 then MsgBmp := LoadBitmap(HLib, PChar(1903));
  570.         if wBmp = 64 then MsgBmp := LoadBitmap(HLib, PChar(1904));
  571.     end;
  572.  
  573. begin
  574.     HLib := LoadLibrary ('MWCC.dll');
  575.     if HPrevInst = 0 then
  576.     begin
  577.         {***
  578.  
  579.             This registers the class - I need to register two. You don't need to register the class
  580.             if its already registered so check HPrevInst.
  581.  
  582.         ***}
  583.         if SFXStyle then
  584.         begin
  585.             SFXWndClass.hInstance      := HInstance;
  586.             SFXWndClass.hCursor        := LoadCursor(0, idc_Arrow);
  587.             SFXWndClass.hbrBackground  := GetStockObject(LtGray_Brush);
  588.             {*** This handle is used to unregistered the class when the message box is destroyed ***}
  589.             SFXWndHdl                  := HInstance;
  590.             if not RegisterClass(SFXWndClass) then Halt(255);
  591.         end
  592.         else
  593.         begin
  594.             MWCCWndClass.hInstance := HInstance;
  595.             MWCCWndClass.hCursor   := LoadCursor(0, idc_Arrow);
  596.             if ABmp <> nil then
  597.             begin
  598.                 BkBmp := LoadBitmap(HLib, ABmp);
  599.                 BkBrush := CreatePatternBrush(BkBmp);
  600.                 MWCCWndClass.hbrBackground := BkBrush;
  601.             end
  602.             else
  603.                 MWCCWndClass.hbrBackground := GetStockObject(LtGray_Brush);
  604.             {*** This handle is used to unregistered the class when the message box is destroyed ***}
  605.             MWCCWndHdl                   := HInstance;
  606.             if not RegisterClass(MWCCWndClass) then Halt(255);
  607.         end;
  608.     end;
  609.     {***
  610.  
  611.             ATextType falls within these values when mb_SystemModal is specified, in which case
  612.             it's passed onto the Windows API MessageBox function.
  613.  
  614.     ***}
  615.     if (ATextType >= 4096) and (ATextType < 8192) then
  616.     begin
  617.         MessageBox(0, ATxt, ACaption, ATextType);
  618.         Halt;
  619.     end;
  620.     if GetSystemMetrics(sm_CYSize) = 26 then
  621.     begin
  622.         a := 80; b := 40; c := 27; d := 20;
  623.     end;
  624.     LastWnd := WndParent;
  625.     lstrCpy(szText, ATxt);
  626.     {***
  627.  
  628.         This long bit sorts out the values passed in ATextType and initializes the appropriate
  629.         things.
  630.  
  631.     ***}
  632.     if ATextType >= 8192 then
  633.         ATextType := ATextType - 8192
  634.     else
  635.     if (ATextType >= 512) and (ATextType < 4096) then
  636.     begin
  637.         Default3 := True;
  638.         ATextType := ATextType - 512;
  639.     end
  640.     else
  641.     if (ATextType >= 256) and (ATextType < 512) then
  642.     begin
  643.         Default2 := True;
  644.         ATextType := ATextType - 256;
  645.     end
  646.     else
  647.         Default1 := True;
  648.     case ATextType of
  649.         0, 64, 48, 16, 32:
  650.         begin
  651.             ID1 := id_Ok;
  652.             LoadBmp(ATextType);
  653.             goto CaseExit;
  654.         end;
  655.         1, 65, 49, 17, 33:
  656.         begin
  657.             ID1 := id_Ok; ID2 := id_Cancel;
  658.             LoadBmp(ATextType - 1);
  659.             goto CaseExit;
  660.         end;
  661.         5, 69, 53, 21, 37:
  662.         begin
  663.             ID1 := id_Retry; ID2 := id_Cancel;
  664.             LoadBmp(ATextType - 5);
  665.             goto CaseExit;
  666.         end;
  667.         4, 68, 52, 20, 36:
  668.         begin
  669.             ID1 := id_Yes; ID2 := id_No;
  670.             LoadBmp(ATextType - 4);
  671.             goto CaseExit;
  672.         end;
  673.         3, 67, 51, 19, 35:
  674.         begin
  675.             ID1 := id_Yes; ID2 := id_No; ID3 := id_Cancel;
  676.             LoadBmp(ATextType - 3);
  677.             goto CaseExit;
  678.         end;
  679.         2, 66, 50, 18, 34:
  680.         begin
  681.             ID1 := id_Abort; ID2 := id_Retry; ID3 := id_Ignore;
  682.             LoadBmp(ATextType - 2);
  683.             goto CaseExit;
  684.         end;
  685.         {*** AtextType ends here ***}
  686.     end;
  687.     CaseExit:
  688.     {*** Loads the up bitmaps needed to speed up the initial drawing of the buttons ***}
  689.     if ID1 <> 0 then if not Default1 then
  690.         UpBmp1 := LoadBitmap(HLib, PChar(1000 + ID1))
  691.     else
  692.         UpBmp1 := LoadBitmap(HLib, PChar(5000 + ID1));
  693.     if ID2 <> 0 then if not Default2 then
  694.         UpBmp2 := LoadBitmap(HLib, PChar(1000 + ID1))
  695.     else
  696.         UpBmp2 := LoadBitmap(HLib, PChar(5000 + ID1));
  697.     if ID3 <> 0 then if not Default3 then
  698.         UpBmp3 := LoadBitmap(HLib, PChar(1000 + ID1))
  699.     else
  700.         UpBmp3 := LoadBitmap(HLib, PChar(5000 + ID1));
  701.     XScreen := GetSystemMetrics(sm_CXScreen);
  702.     YScreen := GetSystemMetrics(sm_CYScreen);
  703.     W := 388 + GetSystemMetrics(sm_CXFrame) + a - e;
  704.     H := 220 + GetSystemMetrics(sm_CYCaption) + GetSystemMetrics(sm_CYFrame) - f;
  705.     {*** Creates an SFX message box window if the SFXMsgbox function is used ***}
  706.     if SFXStyle then
  707.         MsgBoxWnd := CreateWindow('SFXMsgBoxWindow',
  708.                                                             ACaption,
  709.                                                             ws_Popup or ws_Caption or ws_SysMenu or ws_ThickFrame,
  710.                                                             (XScreen - W) div 2,
  711.                                                             (YScreen - H) div 2,
  712.                                                             W, H, 0, 0,
  713.                                                             HInstance,
  714.                                                             nil)
  715.     else
  716.     {*** Creates an MWCC message box window if the MWCCMsgbox function is used ***}
  717.         MsgBoxWnd := CreateWindowEx(ws_Ex_DlgModalFrame,
  718.                                                                 'MWCCMsgBoxWindow',
  719.                                                                 ACaption,
  720.                                                                 ws_Popup or ws_Caption or ws_SysMenu,
  721.                                                                 (XScreen - W) div 2,
  722.                                                                 (YScreen - H) div 2,
  723.                                                                 W, H, 0, 0,
  724.                                                                 HInstance,
  725.                                                                 nil);
  726.     {***
  727.  
  728.         Subclassing the Buttons has three parts - MakeProcInstance, CreateWindow and
  729.         SetWindowLong. Subclassing a dialog is slightly diffent. See the generic demo
  730.         generic.pas that came with your complier.
  731.  
  732.         I only subclass the buttons that are actually used - so hence all the <>'s
  733.  
  734.     ***}
  735.     if ID1 <> 0 then
  736.         ButtonProc1 := MakeProcInstance(@MsgBoxButton1Proc, HInstance);
  737.     if ID2 <> 0 then
  738.         ButtonProc2 := MakeProcInstance(@MsgBoxButton2Proc, HInstance);
  739.     if ID3 <> 0 then
  740.         ButtonProc3 := MakeProcInstance(@MsgBoxButton3Proc, HInstance);
  741.     if (ID1 <> 0) and (ID2 = 0) and (ID3 = 0) then
  742.     begin
  743.         WndButton1 := CreateWindow('Button', nil, ws_Child or ws_Visible or ws_TabStop or
  744.                                                                 bs_OwnerDraw, 156 + b - (e div 2), 142, 74, 54, MsgBoxWnd, ID1,
  745.                                                                 HInstance, nil);
  746.     end
  747.     else
  748.     if (ID1 <> 0) and (ID2 <> 0) and (ID3 = 0) then
  749.     begin
  750.         WndButton1 := CreateWindow('Button', nil, ws_Child or ws_Visible or ws_TabStop or
  751.                                                                 bs_OwnerDraw, 78 + c - (e div 2), 142, 74, 54, MsgBoxWnd, ID1,
  752.                                                                 HInstance, nil);
  753.         WndButton2 := CreateWindow('Button', nil, ws_Child or ws_Visible or ws_TabStop or
  754.                                                                 bs_OwnerDraw, 232 + c * 2 - (e div 2), 142, 74, 54, MsgBoxWnd,
  755.                                                                 ID2, HInstance, nil);
  756.     end
  757.     else
  758.     if (ID1 <> 0) and (ID2 <> 0) and (ID3 <> 0) then
  759.     begin
  760.         WndButton1 := CreateWindow('Button', nil, ws_Child or ws_Visible or ws_TabStop or
  761.                                                                 bs_OwnerDraw, 39 + d - (e div 2), 142, 74, 54, MsgBoxWnd, ID1,
  762.                                                                 HInstance, nil);
  763.         WndButton2 := CreateWindow('Button', nil, ws_Child or ws_Visible or ws_TabStop or
  764.                                                                 bs_OwnerDraw, 155 + d * 2 - (e div 2), 142, 74, 54, MsgBoxWnd,
  765.                                                                 ID2, HInstance, nil);
  766.         WndButton3 := CreateWindow('Button', nil, ws_Child or ws_Visible or ws_TabStop or
  767.                                                                 bs_OwnerDraw, 270 + d * 3 - (e div 2), 142, 74, 54, MsgBoxWnd,
  768.                                                                 ID3, HInstance, nil);
  769.     end;
  770.     {***
  771.  
  772.         OldProc1 etc is a pointer to the parent (old) window procdure return by
  773.         SetWindowLong. It's used by the subclassed children to pass messages back to the parent.
  774.  
  775.     ***}
  776.     if ID1 <> 0 then
  777.         LongInt(OldProc1) := SetWindowLong(WndButton1, gwl_WndProc, LongInt(ButtonProc1));
  778.     if ID2 <> 0 then
  779.         LongInt(OldProc2) := SetWindowLong(WndButton2, gwl_WndProc, LongInt(ButtonProc2));
  780.     if ID3 <> 0 then
  781.         LongInt(OldProc3) := SetWindowLong(WndButton3, gwl_WndProc, LongInt(ButtonProc3));
  782.     {*** Focuses which ever button is the default ***}
  783.     if Default1 = True then
  784.         FocusWnd := WndButton1
  785.     else
  786.     if Default2 = True then
  787.         FocusWnd := WndButton2
  788.     else
  789.     if Default3 = True then
  790.         FocusWnd := WndButton3;
  791.     SetFocus(FocusWnd);
  792.     InvalidateRect(FocusWnd, nil, True);
  793.     {*** System Menu Changes ***}
  794.     SysMenu := GetSystemMenu(MsgBoxWnd, False);
  795.     DeleteMenu(SysMenu, 0, mf_ByPosition);
  796.     DeleteMenu(SysMenu, 1, mf_ByPosition);
  797.     DeleteMenu(SysMenu, 1, mf_ByPosition);
  798.     DeleteMenu(SysMenu, 1, mf_ByPosition);
  799.     DeleteMenu(SysMenu, 1, mf_ByPosition);
  800.     DeleteMenu(SysMenu, 2, mf_ByPosition);
  801.     DeleteMenu(SysMenu, 2, mf_ByPosition);
  802.     DeleteMenu(SysMenu, 1, mf_ByPosition);
  803.     {*** Show and Update the message box window so it gets painted ***}
  804.     ShowWindow(MsgBoxWnd, sw_ShowNormal);
  805.     UpdateWindow(MsgBoxWnd);
  806.     {***
  807.  
  808.         The message box disables LastWnd (WndParent) so it can't be used until the message
  809.         box is destroyed.
  810.  
  811.     ***}
  812.     EnableWindow(LastWnd, False);
  813.     {***
  814.  
  815.         Now that everything is initalized the window enters its message loop and stays there
  816.         until you call 'PostQuitMessage' (in wm_Destroy) - which does just that and the window
  817.         exits the loop.
  818.  
  819.     ***}
  820.     while GetMessage(Msg, 0, 0, 0) do
  821.   begin
  822.         TranslateMessage(Msg);
  823.         DispatchMessage(Msg);
  824.     end;
  825. end;
  826.  
  827. function MWCCMsgBox (WndParent: HWnd; ATxt, ACaption: PChar; ATextType: Word;
  828.                                          ABmp: PChar): Integer;
  829. {*** The other end of the MWCCMsgBox function used in your source code ***}
  830. begin
  831.     InitializeData;
  832.     MsgBoxWinMain (WndParent, ATxt, ACaption, ATextType, ABmp);
  833.     MWCCMsgBox := Reply;
  834.     InitializeData;
  835. end;
  836.  
  837. function SFXMsgBox (WndParent: HWnd; ATxt, ACaption: PChar; ATextType: Word): Integer;
  838. {*** The other end of the SFXMsgBox function used in your source code ***}
  839. begin
  840.     InitializeData;
  841.     {***
  842.  
  843.         SFXStyle tells the program to draw an SFX style message box. 'e' and 'f' are offsets
  844.         used throughout the program to adjust the message box dimensions and produce the
  845.         slightly smaller SFX message box.
  846.  
  847.     ***}
  848.     SFXStyle := True;
  849.     e := 12; f := 1;
  850.     MsgBoxWinMain (WndParent, ATxt, ACaption, ATextType, nil);
  851.     SFXMsgBox := Reply;
  852.     InitializeData;
  853. end;
  854.  
  855. end.